home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr10 / swagabc.zip / COPYMOVE.SWG < prev    next >
Text File  |  1993-06-01  |  32KB  |  1 lines

  1. SWAGOLX.EXE (c) 1993 GDSOFT  ALL RIGHTS RESERVED 00015         FILE COPY/MOVE ROUTINES                                           1      05-28-9313:35ALL                      SWAG SUPPORT TEAM        Copy File #1             IMPORT              6           Program Copy;ππVar InFile, OutFile : File;π    Buffer          : Array[ 1..512 ] Of Char;π    NumberRead,π    NumberWritten   : Word;ππbeginπ   If ParamCount <> 2 Then Halt( 1 );π   Assign( InFile, ParamStr( 1 ) );π   Reset ( InFile, 1 );     {This is Reset For unTyped Files}π   Assign  ( OutFile, ParamStr( 2 ) );π   ReWrite ( OutFile, 1 );  {This is ReWrite For unTyped Files}π   Repeatπ      BlockRead ( InFile, Buffer, Sizeof( Buffer ), NumberRead );π      BlockWrite( OutFile, Buffer, NumberRead, NumberWritten );π   Until (NumberRead = 0) or (NumberRead <> NumberWritten);π   Close( InFile );π   Close( OutFile );πend.π              2      05-28-9313:35ALL                      SWAG SUPPORT TEAM        Copy File #2             IMPORT              30          {I've been trying to figure out how to do a fairly fast copyπ in pascal.  It doesn't have to be faster then Dos copy, butπ I definatly DON'T want to shell out to Dos to do it!π I've got the following working... in the IDE of Turbo 6.0!π If I compile it, it wont work at all.  ALSO... If you COMPπ the Files to check For errors, They are there.  (UGH!)π (ie, it isn't a perfect copy!)π The thing is I want to get as much as I can in each pass!π (But turbo has limits!)π Heres my code... Just rough, so no Real comments.π}ππProgram Copy (InFile, OutFile);ππUses Dos;ππVarπ   I, Count, BytesGot : Integer;π   BP : Pointer;π   InFile,OutFile:File;ππ   FI,FO : Word;ππ   Path,π   FileName : String[80];ππ   DirInfo : SearchRec;π   BaseRec, RecSize : longInt;ππbeginπ   FileName := ParamStr(1);             {Set the SOURCE as the first ParamSTR}π   Path := ParamStr(2);                 {Set the Dest.  as the 2nd paramSTR}ππ   If paramCount = 0 Thenπ      beginπ           Writeln('FastCopy (C) 1993 - Steven Shimatzki');π           Writeln('Version : 3.0   Usage: FastCopy <Source> <Destination>');π           Halt(1);π      end;ππ   FindFirst(FileName,Archive,DirInfo);ππ   If DirInfo.Name <> '' Thenπ   beginππ       RecSize := MaxAvail - 1024;  {Get the most memory but leave some}π       BaseRec := RecSize;ππ       If RecSize > DirInfo.Size Then      {If a "SMALL" File, gobble it up}π           RecSize := DirInfo.Size;        {In one pass!  Size = Recordsize}ππ       Count := DirInfo.Size Div RecSize;  {Find out how many Passes!}ππ       GetMem (Bp, RecSize);   {Allocate memory to the dynamic Variable}ππ       Assign (InFile,FileName);       {Assign the File}π       Assign (OutFile,Path);          {Assign the File}ππ       Filemode := 0;     {Open the INFile as READONLY}ππ       Reset(InFile,RecSize);      {open the input}π       ReWrite(OutFile,RecSize);   {make the output}πππ       For I := 1 to Count do    {Do it For COUNT passes!}π       beginππ            {$I-}π            Blockread(InFile,BP^,1,BytesGot);   {Read 1 BLOCK}π            {$I+}ππ            BlockWrite(outFile,BP^,1,BytesGot);   {Write 1 BLOCK}ππ            If BytesGot <> 1 Thenπ               Writeln('Error!  Disk Full!');ππ       end;ππ{If not all read in, then I have to get the rest seperatly!  partial Record!}ππ       If Not ((Count * RecSize) = DirInfo.Size) Thenπ       beginπ            RecSize := (DirInfo.Size - (Count * RecSize)) ;π                       {^^^ How much is left to read? get it in one pass!}πππ            FreeMem(Bp, BaseRec);      {Dump the mem back}π            GetMem(Bp, RecSize);       {Get the new memory}ππ            FileMode := 0;         {Set input For readonly}ππ            Reset (InFile,1);ππ            Filemode := 2;         {Set output For Read/Write}ππ            Reset (OutFile,1);ππ            Seek(InFile, (Count * BaseRec));   {Move to old location}π            Seek(OutFile, (Count * BaseRec));{ same }ππ            FI := FilePos(InFile);    {Just used to see where I am in the File}π            FO := FilePos(OutFile);   {Under the Watch Window... Remove later}ππ            {$I-}π            BlockRead(InFile,Bp^,RecSize,BytesGot);    {REad the File}π            {$I+}ππ            BlockWrite(OutFile,Bp^,RecSize,BytesGot);  {Write the File}ππ       end;ππ       Close(OutFile);π       Close(InFile);ππ       FreeMem (Bp,RecSize);ππ   end;ππend.ππ{πYou don't close the input- and output File when your finished With theπfirst count passes. Maybe your last block will not be written to disk,πwhen you reopen the outputFile For writing. I can't see another problemπright now.                                                                                                       3      05-28-9313:35ALL                      SWAG SUPPORT TEAM        Copy File #3             IMPORT              10          {π> Or can someone put up some Procedure that will copy Files.π}ππ{$O+}ππUsesπ  Dos;ππFunction CopyFile(SourceFile, TargetFile : String): Byte;π{ Return codes:  0 successfulπ                 1 source and target the sameπ                 2 cannot open sourceπ                 3 unable to create targetπ                 4 error during copyπ}πVarπ  Source,π  Target  : File;π  BRead,π  BWrite  : Word;π  FileBuf : Array[1..2048] of Char;πbeginπ  If SourceFile = TargetFile thenπ  beginπ    CopyFile := 1;π    Exit;π  end;π  Assign(Source,SourceFile);π  {$I-}π  Reset(Source,1);π  {$I+}π  If IOResult <> 0 thenπ  beginπ    CopyFile := 2;π    Exit;π  end;π  Assign(Target,TargetFile);π  {$I-}π  ReWrite(Target,1);π  {$I+}π  If IOResult <> 0 thenπ  beginπ    CopyFile := 3;π    Exit;π  end;π  Repeatπ    BlockRead(Source,FileBuf,SizeOf(FileBuf),BRead);π    BlockWrite(Target,FileBuf,Bread,BWrite);π  Until (Bread = 0) or (Bread <> BWrite);π  Close(Source);π  Close(Target);π  If Bread <> BWrite thenπ    CopyFile := 4π  elseπ    CopyFile := 0;πend; {of func CopyFile}ππ                                                                                         4      05-28-9313:35ALL                      SWAG SUPPORT TEAM        Copy File #4             IMPORT              20          {I am having a bit of a problem in Pascal.  I am writing a routine toπcopy Files.  The Program is to be used in an area where anything atπall can happen, so it has to be totally bullet-proof.  All is well,πexcept one little thing.  Should the Program encounter a major diskπerror (for example, the user removes the disk While the copy is takingπplace), the Program breaks into Dos after an 'Abort, Retry, Fail'πprompt.  Now comes the weird part.  This crash to Dos only occurs onlyπonce the Program terminates.  It processes the error perfectly, and onlyπgives the error once my entire Program is at an end!  Following is theπsource code in question:π}πProgram FileTest;ππUsesπ  Dos;ππProcedure FileCopy(SrcPath, DstPath, FSpec : String; Var ExStat : Integer);πVarπ  DirInfo : SearchRec;π  Done    : Boolean;ππProcedure Process(X : String);πVarπ  Source,π  Dest     : File;π  Buffer   : Array[1..4096] of Byte;π  ReadCnt,π  WriteCnt : Word;ππbeginπ  {$I-}π  ExStat:=0;π  Assign(Source,SrcPath+X);π  Reset(Source,1);π  If IOResult <> 0 thenπ    ExStat := 1;π  If ExStat = 0 thenπ  beginπ    Assign(Dest,DstPath+X);π    ReWrite(Dest,1);π    If IOResult <> 0 thenπ      ExStat := 2;π    If ExStat = 0 thenπ    beginπ      Repeatπ        BlockRead(Source,Buffer,Sizeof(Buffer),ReadCnt);π        BlockWrite(Dest,Buffer,ReadCnt,WriteCnt);π        If IOResult <> 0 thenπ          ExStat := 3;π      Until (ReadCnt = 0) or (WriteCnt <> ReadCnt) or (ExStat <> 0);π      Close(Dest);π    end;π    Close(Source);π  end;π  {$I+}πend;ππbeginπ  {$I-}π    ExStat := 0;π    FindFirst(SrcPath + FSpec, Archive, DirInfo);π    Done := False;π    While Not Done doπ    beginπ      Write('Copying ',DirInfo.Name,' ');π      Process(DirInfo.Name);π      If (ExStat = 0) thenπ      beginπ        FindNext(DirInfo);π        If (DosError<>0) thenπ          Done := True;π      endπ      elseπ        Done := True;π    end;π  {$I+}πend;ππProcedure Main;πVarπ  ExC : Integer;πbeginπ  FileCopy('C:\Dos\','A:\','*.BAS',ExC);π  Writeln('Exit Code:',ExC);πend;ππbeginπ  Main;π  Writeln('Program is Complete');πend.π{πThat's it.  All errors get logged normally, and right after 'Program isπComplete', I get an 'Abort, Retry, Fail'.  It must be a File left open,πand TP tries to close it once the Program terminates, but I can'tπimagine which File it might be!π}                                                                                                       5      05-28-9313:35ALL                      SWAG SUPPORT TEAM        Copy File #5             IMPORT              16          { copy Files With certain extentions to a specific directory (Bothπ parameters specified at the command line or in a Text File).. I cannotπ seem to find a command withing TP 6.0 to copy Files.. I have lookedπ several times through the manuals but still no luck.. I even asked theπ teacher in Charge and he did not even know! Ok all you Programmers outπ there.. Show your stuff.. If you Really want to be kind, help me outπ on this..I am just starting in TP and this is all new to me!π}ππ{$R-,I+} {Set range checking off, IOChecking on}π{$M $400, $2000, $10000} {Make sure enough heap space}π{    1k Stack, 8k MinHeap, 64k MaxHeap }πTypeπ        Buf = Array[0..65527] of Byte;πVarπ        FileFrom, FileTo : File;π        Buffer : ^Buf;π        BytesToRead, BytesRead : Word;π        MoreToCopy, IoStatus : Boolean;ππbeginπ        {Determine largest possible buffer useable}π        If MaxAvail < 65528 thenπ                BytesToRead := MaxAvailπ        elseπ                BytesToRead := 65528;π        Writeln('Program is using ', BytesToRead , ' Bytes of buffer');π        GetMem(Buffer, BytesToRead);    {Grab heap memory For buffer}π        Assign(FileFrom, 'File_1');π        Assign(FileTo, 'File_2');π        Reset(FileFrom, 1);     {Open File With 1Byte Record size}π        ReWrite(FileTo, 1);π        IoStatus := (IoResult = 0);π        MoreToCopy := True;π        While IoStatus and MoreToCopy do beginπ        {$I-}π                blockread(FileFrom, Buffer^, BytesToRead, BytesRead);π                blockWrite(FileTo, Buffer^, BytesRead);π        {$I+}π                MoreToCopy := (BytesRead = BytesToRead);π                IoStatus := (IoResult=0);π        end;π        Close(FileTO);π        Close(FileFrom);π        FreeMem(Buffer, BytesToRead); {Release Heap memory}π        If (not IoStatus) thenπ            Writeln('Error copying File!!!');πend.π                                                6      05-28-9313:35ALL                      SWAG SUPPORT TEAM        Copy File #6             IMPORT              33          {$A+,B-,D-,E+,F-,I+,L-,N-,O-,R+,S+,V-}π{$M 16384,65536,655360}ππProgram scopy;ππUsesπ  Dos,π  tpDos,π  sundry,π  Strings;ππTypeπ  buffer_Type = Array[0..65519] of Byte;π  buffptr     = ^buffer_Type;ππVarπ  f1,f2       : File;π  fname1,π  fname2,π  NewFName,π  OldDir      : PathStr;π  SRec        : SearchRec;π  errorcode   : Integer;π  buffer      : buffptr;πConstπ  MakeNewName : Boolean = False;π  FilesCopied : Word = 0;π  MaxHeapSize = 65520;ππFunction IOCheck(stop : Boolean; msg : String): Boolean;π  Varπ    error : Integer;π  beginπ    error := Ioresult;π    IOCheck := (error = 0);π    if error <> 0 then beginπ      Writeln(msg);π      if stop then beginπ        ChDir(OldDir);π        halt(error);π      end;π    end;π  end;ππProcedure Initialise;π  Varπ    temp  : String;π    dir   : DirStr;π    name  : NameStr;π    ext   : ExtStr;π  beginπ    if MaxAvail < MaxHeapSize then beginπ      Writeln('Insufficient memory');π      halt;π    endπ    elseπ      new(buffer);π    {I-} GetDir(0,OldDir); {$I+} if IOCheck(True,'') then;π    Case ParamCount ofπ      0: beginπ           Writeln('No parameters provided');π           halt;π         end;π      1: beginπ           TempStr := ParamStr(1);π           if not ParsePath(TempStr,fname1,fname2) then beginπ             Writeln('Invalid parameter');π             halt;π           end;π           {$I-} ChDir(fname2); {$I+} if IOCheck(True,'') then;π         end;π      2: beginπ           TempStr := ParamStr(1);π           if not ParsePath(TempStr,fname1,fname2) then beginπ             Writeln('Invalid parameter');π             halt;π           endπ           elseπ             {$I-} ChDir(fname2); {$I+} if IOCheck(True,'') then;ππ           TempStr := ParamStr(2);π           if not ParsePath(TempStr,fname2,temp) then beginπ             Writeln('Invalid parameter');π             halt;π           end;π           FSplit(fname2,dir,name,ext);π           if length(name) <> 0 thenπ             MakeNewName := True;π         end;π    else beginπ           Writeln('too many parameters');π           halt;π         end;π    end; { Case }π  end; { Initialise }ππProcedure CopyFiles;π  Varπ    result : Word;ππ  Function MakeNewFileName(fn : String): String;π    Varπ      temp  : String;π      dir   : DirStr;π      name  : NameStr;π      ext   : ExtStr;π      numb  : Word;π    beginπ      numb := 0;π      FSplit(fn,dir,name,ext);π      Repeatπ        inc(numb);π        if numb > 255 then beginπ          Writeln('Invalid File name');π          halt(255);π        end;π        ext := copy(Numb2Hex(numb),2,3);π        temp := dir + name + ext;π        Writeln(temp);π      Until not ExistFile(temp);π      MakeNewFileName := temp;π    end; { MakeNewFileName }πππ  beginπ    FindFirst(fname1,AnyFile,Srec);π    While Doserror = 0 do beginπ      if (SRec.attr and $19) = 0 then beginπ        if MakeNewName thenπ          NewFName := fname2π        elseπ          NewFName := SRec.name;π        if ExistFile(NewFName) thenπ          NewFName := MakeNewFileName(NewFName);π        {$I-}π        Writeln('Copying ',SRec.name,' > ',NewFName);π        assign(f1,SRec.name);π        reset(f1,1);π        if { =1= } IOCheck(False,'1. Cannot copy '+fname1) then beginπ          assign(f2,fname2);π          reWrite(f2,1);π          if IOCheck(False,'2. Cannot copy '+SRec.name) thenπ            Repeatπ              BlockRead(f1,buffer^,MaxHeapSize);π              if IOCheck(False,'3. Cannot copy '+SRec.name) thenπ                result := 0π              else beginπ                BlockWrite(f2,buffer^,result);π                if IOCheck(False,'4. Cannot copy '+NewFName) thenπ                  result := 0;π              end;π            Until result < MaxHeapSize;π          close(f1); close(f2);π          if IOCheck(False,'Error While copying '+SRec.name) then;π        end; { =1= }π      end;  { if SRec.attr }π      FindNext(Srec);π    end; { While Doserror = 0 }π  end; { CopyFiles }ππbeginπ  Initialise;π  CopyFiles;π  ChDir(OldDir);πend.ππ                                                                                       7      05-28-9313:35ALL                      SWAG SUPPORT TEAM        Copy File with Display   IMPORT              15          Hello Matthew!ππAnswering a msg of <Monday April 12 1993>, from Matthew Staikos to All:ππThe Norton-like bar along with the copying won't compile,πbut you get the idea, no?ππ  {$I-}π  function __copyfil(π    show: boolean; x1,x2,y,f,b: byte; fs: longint; src, targ: stringπ  ): byte;π  {π   return codes:π     0 successfulπ     1 source and target the sameπ     2 cannot open sourceπ     3 unable to create targetπ     4 error during copyπ     5 cannot allocate bufferπ  }π  constπ    bufsize = 16384;ππ  typeπ    fbuf = array[1..bufsize] of char;π    fbf  = ^fbuf;ππ  varπ    source,π    target   :    file;π    bread,π    bwrite   :    word;π    filebuf  :    ^fbf;π    tr       : longint;π    nr       :    real;ππ  beginπ    if memavail > bufsize then new(filebuf) else beginπ      __copyfil := 5; exitπ    end;π    if src = targ then begin __copyfil := 1; exit end;π    assign(source, src); reset(source,1);π    if ioresult <> 0 then begin __copyfil := 2; exit end;π    assign(target, targ); rewrite(target,1);π    if ioresult <> 0 then begin __copyfil := 3; exit end;π    if show then __write(x1+2,y,f,b,__rep(x2-x1-3,'░')); tr := 0;π    repeatπ      blockread(source,filebuf^,bufsize,bread);π      tr := tr + bread; nr := tr/fs;π      nr := nr * (x2-x1-3);π      if show then __write(x1+2,y,f,b,__rep(trunc(nr), '█'));π      blockwrite(target,filebuf^,bread,bwrite);π    until (bread = 0) or (bread <> bwrite);π    if show then __write(x1+2,y,f,b,__rep((x2-x1-3),'█'));π    close(source); close(target);π    if bread <> bwrite then __copyfil := 4 else __copyfil := 0;π  end;π  {$I-}πππππFloorππ--- GoldED 2.40π * Origin: UltiHouse/2 5 Years! V32b/HST/16k8: x31,13,638709 (2:512/195)π                                                                                                      8      05-28-9313:35ALL                      SWAG SUPPORT TEAM        Copy File from ECO-LIB   IMPORT              14          {πNote : Functions beginning with "__" come from the ECO Library - Kerry.ππFLOOR A.C. NAAIJKENSππThe Norton-like bar along with the copying won't compileππ{$I-}πfunction __copyfil(show : boolean; x1, x2, y, f, b : byte;π                   fs : longint; src, targ : string) : byte;π{π return codes:π  0 successfulπ  1 source and target the sameπ  2 cannot open sourceπ  3 unable to create targetπ  4 error during copyπ  5 cannot allocate bufferπ}πconstπ  bufsize = 16384;ππtypeπ  fbuf = array[1..bufsize] of char;π  fbf  = ^fbuf;ππvarπ  source,π  target   :    file;π  bread,π  bwrite   :    word;π  filebuf  :    ^fbf;π  tr       : longint;π  nr       :    real;ππbeginπ  if memavail > bufsize thenπ    new(filebuf)π  elseπ  beginπ    __copyfil := 5;π    exitπ  end;π  if src = targ thenπ  beginπ    __copyfil := 1;π    exitπ  end;π  assign(source, src);π  reset(source,1);π  if ioresult <> 0 thenπ  beginπ    __copyfil := 2;π    exitπ  end;π  assign(target, targ);π  rewrite(target,1);π  if ioresult <> 0 thenπ  beginπ    __copyfil := 3;π    exitπ  end;π  if show thenπ    __write(x1 + 2 , y, f, b, __rep(x2 - x1 - 3, '░'));π  tr := 0;π  repeatπ    blockread(source, filebuf^, bufsize, bread);π    tr := tr + bread;π    nr := tr / fs;π    nr := nr * (x2 - x1 - 3);π    if show thenπ      __write(x1 + 2, y, f, b, __rep(trunc(nr), '█'));π    blockwrite(target, filebuf^, bread, bwrite);π  until (bread = 0) or (bread <> bwrite);π  if show thenπ    __write(x1 + 2, y, f, b, __rep((x2 - x1 - 3), '█'));π  close(source);π  close(target);π  if bread <> bwrite thenπ    __copyfil := 4π  elseπ    __copyfil := 0;πend;π{$I-}ππ                                             9      05-28-9313:35ALL                      SWAG SUPPORT TEAM        FAST Copy File           IMPORT              5           {│o│ I want to make my buffer For the BlockRead command as       │o║π│o│ large as possible. When I make it above 11k, I get an       │o║π│o│ error telling me "too many Variables."                      │o║πUse dynamic memory, as in thanks a heap.π}πππif memavail > maxint  { up to 65520 }πthen bufsize := maxintπelse bufsize := memavail;πif i<128πthen Exitmsg('No memory')πelse getmem(buf,bufsize);πππ                                                                                                                10     05-28-9313:35ALL                      SWAG SUPPORT TEAM        Move File #1             IMPORT              49          {πI found a source * COPY.PAS * (don't know where anymore or who posted it) andπtried to Write my own move_Files Program based on it.ππThe simple idea is to move the Files specified in paramstr(1) to a destinationπdirectory specified in paramstr(2) and create the directories that do not yetπexist.ππOn a first look it seems just to work out ok. But yet it does not.ππto help me find the failure set paramstr(1) to any path you want (For exampleπD:\test\*.txt or whatever) and set paramstr(2) to a non existing path which isπC:\A\B\C\D\E\F\G\H\..\Z\A\B\C\D\E\F\ππThe directories C:\A through C:\A\B\C\D\F\..\Q\R\S will be created and than theπProgram hangs.ππWho can help me find what the mistake is?ππI Really will be grateful For any kind of help.ππThe code is:π}ππ{$A+,B-,D+,E+,F-,G-,I-,L+,N-,O-,R+,S-,V+,X-}πProgram aMOVE;ππUsesπ  Crt, Dos;πConstπ  BufSize = 32768;πVarπ  ioCode               : Byte;π  SrcFile, DstFile     : File;π  FileNameA,π  FileNameB            : String;π  Buffer               : Array[1..BufSize] of Byte;π  RecsRead             : Integer;π  DiskFull             : Boolean;π  CurrDir              : DirStr;        {Aktuelles Verzeichnis speichern}π  HelpList             : Boolean;       {Hilfe uber mogliche Parameter?}π  i,π  n                    : Integer;π  str                  : String[1];ππ  SDStr                : DirStr;        {Quellverzeichnis}π  SNStr                : NameStr;       {Quelldateiname}π  SEStr                : ExtStr;        {Quelldateierweiterung}ππ  DDStr                : DirStr;        {Zielverzeichnis}π  DNStr                : NameStr;       {Zieldateiname}π  DEStr                : ExtStr;        {Zieldateierweiterung}ππ  SrcInfo              : SearchRec;     {Liste der Quelldateien}π  SubDirStr            : Array [0..32] of DirStr;π  key                  : Char;πππ  Procedure SrcFileError(ioCode : Byte);π  beginπ    Write(#7, 'I/O result of ', ioCode, ' (decimal) ', #26);π    Case ioCode ofπ      $01 : WriteLn(' Source File not found.');π      $F3 : WriteLn(' too many Files open.');π    else WriteLn(' "Reset" unknown I/O error.');π    end;π  end;ππ  Procedure DstFileError(ioCode : Byte);π  beginπ    Write(#7, 'I/O result of ', ioCode, ' (decimal) ', #26);π    Case ioCode ofπ      $F0 : WriteLn(' Disk data area full.');π      $F1 : WriteLn(' Disk directory full.');π      $F3 : WriteLn(' too many Files open.');π    else WriteLn(' "ReWrite" unknown I/O error.');π    end;π  end;ππππProcedure EXPAR;                      {externe Parameter abfragen} beginπ  GetDir(0,CurrDir);                  {Aktuelles Verzeichnis speichern}π  if DDStr='' then DDStr:= CurrDir;   {Wenn keine Zialangabe, dann insπ                                       aktuelle Verzeichnis verschieben}π  FSplit(paramstr(1), SDStr, SNStr, SEStr);πend;ππProcedure Copy2Dest;πbeginπ  if FileNameB <> FileNameA thenπ    beginπ      Assign(SrcFile, FileNameA);π      Assign(DstFile, FileNameB);π      {* note second parameter in "reset" and "reWrite" of UNTyped Files. *}π      {$I-} Reset(SrcFile, 1); {$I+}π      ioCode := Ioresult;π      if (ioCode <> 0) then SrcFileError(ioCode)π      elseπ        beginπ          {$I-} ReWrite(DstFile, 1); {$I+}π          ioCode := Ioresult;π          if (ioCode <> 0) then DstFileError(ioCode)π          elseπ            beginπ              DiskFull := False;π              While (not EoF(SrcFile)) and (not DiskFull) doπ                beginπ                  {* note fourth parameter in "blockread". *}π                  {$I-}π                  BlockRead(SrcFile, Buffer, BufSize, RecsRead);π                  {$I+}π                  ioCode := Ioresult;π                  if ioCode <> 0 thenπ                    beginπ                      SrcFileError(ioCode);π                      DiskFull := Trueπ                    endπ                  elseπ                    beginπ                      {$I-}π                      BlockWrite(DstFile, Buffer, RecsRead);π                      {$I+}π                      ioCode := Ioresult;π                      if ioCode <> 0 thenπ                        beginπ                          DstFileError(ioCode);π                          DiskFull := Trueπ                        endπ                    endπ                end;π              if not DiskFull then WriteLn(FileNameB)π            end;π          Close(DstFile)π        end;π      Close(SrcFile)π    endπ  else WriteLn(#7, 'File can not be copied onto itself.')πend;ππProcedure ProofDest;πbeginπ  if length(paramstr(2)) > 67 then beginπ    Writeln;π    Writeln(#7,'Invalid destination directory specified.');π    Writeln('Program aborted.');π    Halt(1);π  end;π  FSplit(paramstr(2), DDStr, DNStr, DEStr);π  if copy(DNStr,length(DNStr),1)<>'.' then beginπ    insert(DNStr,DDStr,length(DDStr)+1);π    DNStr:='';π  end;π  if copy(DDStr,length(DDStr),1)<>'\' thenπ    insert('\',DDSTR,length(DDStr)+1);π  SubDirStr[0]:= DDStr;π  For i:= 1 to 20 do beginπ    SubDirStr[i]:=copy(DDStr,1,pos('\',DDStr));π    Delete(DDStr,1,pos('\',DDStr));π  end;π  For i:= 32 doWNto 1 do beginπ    if SubDirStr[i]= '' then n:= i-1;π  end;ππ  DDStr:= SubDirStr[0];π  SubDirStr[0]:='';ππ  For i:= 1 to n do beginπ    SubDirStr[0]:= SubDirStr[0]+SubDirStr[i];ππ    if copy(SubDirStr[0],length(SubDirStr[0]),1)='\' thenπ      delete(SubDirStr[0],length(SubDirStr[0]),1);ππ beginπ      {$I-}π      MkDir(SubDirStr[0]);π      {$I+}π      if Ioresult = 0 thenπ      WriteLn('New directory created: ', SubDirStr[0]);π    end;ππ    if copy(SubDirStr[0],length(SubDirStr[0]),1)<>'\' thenπ      insert('\',SubDirStr[0],length(SubDirStr[0])+1);π  end;πend;ππProcedure HandleMove;πbeginπ  FileNameA:= SDStr+SrcInfo.Name;π  FileNameB:= DDStr+SrcInfo.Name;π  Copy2Dest;π  Erase(SrcFile);πend;ππProcedure ExeMove;πbeginπ  ProofDest;π  FindFirst(paramstr(1), AnyFile, SrcInfo);π  While DosError = 0 do beginπ    HandleMove;π    FindNext(SrcInfo);π  end;πend;ππππbeginπ  SDStr:= '';π  SNStr:= '';π  SEStr:= '';π  DDStr:= '';π  DNStr:= '';π  DEStr:= '';π  For i:=0 to 32 do SubDirStr[i]:='';π  ExPar;π  ExeMove;πend.π                                                                                 11     05-28-9313:35ALL                      SWAG SUPPORT TEAM        Move File #2             IMPORT              7           {π> How would I move a File from within my Program.ππif the File is to moved from & to the same partition,πall you have to do is:ππ  Assign(F,OldPath);π  Rename(F,NewPath);ππOn the other hand, if the File is to be moved to a differentπpartition, you will have to copy / erase the File.πExample:π}πProgram MoveFile;ππVarπ  fin,fout  : File;π  p         : Pointer;π  w         : Word;ππbeginπ  GetMem(p,64000);π  Assign(fin,ParamStr(1));               { Assumes command line parameter. }π  Assign(fout,ParamStr(2));π  Reset(fin);π  ReWrite(fout);π  While not Eof(fin) doπ  beginπ    BlockRead(fin,p^,64000,w);π    BlockWrite(fout,p^,w);π  end;π  Close(fin);π  Close(fout);π  Erase(fin);π  FreeMem(p,64000);πend.ππ{πThis Program has NO error control.π}                   12     05-28-9313:35ALL                      SWAG SUPPORT TEAM        Move File FAST           IMPORT              13          {$S-,R-,V-,I-,N-,B-,F-}ππ{$IFNDEF Ver40}π  {Allow overlays}π  {$F+,O-,X+,A-}π{$ENDIF}ππUNIT MoveFile;ππINTERFACEππUSES Dos;ππFUNCTION MoveFiles ( VAR OldFullPath : PathStr;π                     VAR NewFullPath : PathStr) : BOOLEAN;ππIMPLEMENTATIONπππFUNCTION MoveFiles ( VAR OldFullPath : PathStr;π                     VAR NewFullPath : PathStr) : BOOLEAN;ππVARπ  regs : REGISTERS;π  Error_Return,π  N      : BYTE;ππ  PROCEDURE MoveToNewPath;π  { On same disk drive }π  BEGINπ  OldFullPath [LENGTH (OldFullPath) + 1] := CHR (0);π  NewFullPath [LENGTH (NewFullPath) + 1] := CHR (0);π  WITH regs DOπ    BEGINπ      DS := SEG (OldFullPath);π      DX := OFS (OldFullPath) + 1;  {the very first byte is the length}π      ES := SEG (NewFullPath);π      DI := OFS (NewFullPath) + 1;π      AX := $56 SHL 8;               { ERRORS are             }π      INTR ($21, regs);                {   2 : file not found   }π      IF Flags AND 1 = 1 THEN        {   3 : path not found   }π        error_return := AX           {   5 : access denied    }π      ELSE                           {  17 : not same device  }π        error_return := 0;π    END;  {with}π  END;ππBEGINπ  Error_Return := 0;π  IF OldFullPath [1] = '\' THEN OldFullPath := FExpand (OldFullPath);π  IF NewFullPath [1] = '\' THEN NewFullPath := FExpand (NewFullPath);π  IF UPCASE (OldFullPath [1]) = UPCASE (NewFullPath [1]) THEN MoveToNewPathπ     ELSE Error_Return := 17;ππMoveFiles := (Error_Return = 0);πEND;ππEND.                                                                     13     05-28-9313:35ALL                      SWAG SUPPORT TEAM        Rename File #1           IMPORT              6           {π> Does anybody know how to do a "fast" move of a File?π> ie: not copying it but just moving the FAT Recordππ  Yup.  In Pascal you can do it With the Rename command.  The Format is:ππ   Rename (Var F; NewName : String)ππwhere F is a File Variable of any Type.ππto move a File Really fast, and to avoid having to copy it somewhere first andπthen deleting the original, do this:π}ππProcedure MoveIt;  {No error checking done}πVarπ   F : File;π   FName : String;π   NName : String;πbeginπ   Assign (F, FName);π   NName:= {new directory / File name}π   Rename (F, NName);πEnd.                                                                   14     05-28-9313:35ALL                      SWAG SUPPORT TEAM        Rename File #2           IMPORT              14          {π>I am interested in the source in Assembler or TP to move a File from oneπ>directory to another by means of the FAT table.  I have seen severalπ>small utilities to do this but I was unable to understand them afterπ>reverse engineering/disassembly.  (Don't worry, they were PD).  <G>π>Anyway, any help would be appreciated.  Thanks.ππYou don't Really need to do much. Dos Interrupt (21h), Function 56h, willπrename a File, and in essence move it if the source and destinationπdirectories are not the same. That's all there is to it. I know Functionπ56h is available in Dos 3.3 and above. I am not sure about priorπversions.ππOn entry: AH      56Hπ          DS:DX   Pointer to an ASCIIZ String containing the drive, path,π                  and Filename of the File to be renamed.π          ES:DI   Pointer to an ASCIIZ String containing the new path andπ                  FilenameπOn return AX      Error codes if carry flag set, NONE if carry flag not setππBelow is some crude TP code I Typed on the fly. It may not be exactly rightπbut you get the idea.π}ππUsesπ  Dos;πVarπ  Regs        : Registers;π  Source,π  Destination : PathStr;ππbeginπ  { Add an ASCII 0 at the end of the Strings to male them ASCIIZπ    Strings, without actually affecting their actual lengths }π  Source[ord(Source[0])] := #0;π  Destination[ord(Destination[0])] := #0;ππ  { Set the Registers }π  Regs.AH := $56;π  Regs.DS := Seg(Source[1]);π  Regs.DX := ofs(Source[1]);π  Regs.ES := Seg(Destination[1]);π  Regs.DI := ofs(Destination[1]);ππ  { Do the Interrupt }π  Intr($21,Regs);πend.π                                                                                                      15     05-28-9313:35ALL                      SWAG SUPPORT TEAM        Move File with Rename    IMPORT              8           {π│ I am interested in the source in Asm or TP to move a File from oneπ│ directory to another by means of the FAT table.ππAll you have to do is use the Rename Procedure.  It isn't done via theπFAT table, but via Dos Function 56h.  The only restrictions are (1)πyou must be running on Dos 2.0 or greater, and (2) the original andπtarget directories must be on the same drive.  The code might lookπsomething like this:π}ππFunction MoveFile( FileName, NewDir: Dos.PathStr ): Boolean;πVarπ  f:      File;π  OldDir: Dos.DirStr;π  Nam:    Dos.NameStr;π  Ext:    Dos.ExtStr;πbeginπ  Dos.FSplit( FileName, OldDir, Nam, Ext );π  if NewDir[ Length(NewDir) ] <> '\' thenπ    NewDir := NewDir + '\';π  {$I-}π  Assign( f, FileName );π  FileName := NewDir + Nam + Ext;π  Rename( f, FileName );π  MoveFile := (Ioresult=0);π  {$I+}πend; { MoveFile }π